home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / amok_lha / amok40.lha / MischMasch / MischMasch.Mod < prev    next >
Text File  |  1993-08-15  |  17KB  |  511 lines
  1. MODULE MischMasch;
  2. (*---------------------------------------------------------------------------
  3.    :Program.    MischMasch
  4.    :Contents.    from Scientific American "Computer Kurzweil"
  5.    :Version.    1.0
  6.    :History.    Apr-90
  7.    :Author.     Markus Peuckert
  8.    :Address.    Schützenstr. 50, D-3550 Marburg, West-Germany,
  9.    :Copyright.  PD
  10.    :Language.   Modula-2
  11.    :Translator. M2Amiga V3.3d
  12. ---------------------------------------------------------------------------*)
  13.  
  14.  
  15. FROM SYSTEM    IMPORT    INLINE, ADR, ADDRESS, FFP;
  16. FROM Arts    IMPORT    Assert, TermProcedure, CurrentLevel;
  17. FROM Intuition    IMPORT    ScreenPtr, WindowPtr, WindowFlags, WindowFlagSet,
  18.             ScreenFlags, ScreenFlagSet, customScreen,
  19.             IDCMPFlagSet, IDCMPFlags, CloseWindow, IntuiMessagePtr,
  20.             CloseScreen;
  21. FROM Graphics    IMPORT    ViewModes, ViewModeSet, LoadRGB4, ViewPortPtr, SetRast,
  22.             RastPortPtr, SetAPen, RectFill, Move, Text, SetBPen;
  23. FROM Exec    IMPORT    GetMsg, ReplyMsg;
  24. FROM InOut    IMPORT    WriteString, ReadInt;
  25. FROM Conversions IMPORT ValToStr;
  26. FROM RandomNumber IMPORT RND;
  27. FROM IntuiSup    IMPORT    CreateScreen, CreateWindow;
  28. FROM Terminal    IMPORT    waitCloseGadget;
  29.  
  30.  
  31. CONST    WIDTH      = 320;
  32.     HEIGHT     = 256;
  33.     FTaste    = 023H;
  34.     ESC    = 045H;
  35.  
  36.     MaxSeg    = 100;
  37.     ges    = 0;
  38.     inf    = 1;
  39.     krnk    = 2;
  40.  
  41. TYPE    Segment    =    RECORD
  42.                 zus, infi,
  43.                 x, y, dx, dy    : INTEGER;
  44.             END;
  45.     MatrixTyp=    ARRAY [0..MaxSeg], [0..MaxSeg] OF Segment;
  46.  
  47. VAR    Level        : INTEGER;
  48.     scr        : ScreenPtr;
  49.     win        : WindowPtr;
  50.     rp        : RastPortPtr;
  51.     vp        : ViewPortPtr;
  52.     Msg        : IntuiMessagePtr;
  53.     class        : IDCMPFlagSet;
  54.     code        : CARDINAL;
  55.     toggle        : BOOLEAN;
  56.     DEPTH, MaxCol    : INTEGER;
  57.  
  58.     Z, Zt        : MatrixTyp;
  59.     g, k1, k2,
  60.     MaxFeld, MaxInf : INTEGER;
  61.     FarbFak        : FFP;
  62.  
  63.  
  64. PROCEDURE FarbTest;
  65. VAR i : INTEGER;
  66. BEGIN
  67.  FOR i:=0 TO MaxCol-1 DO
  68.   SetAPen (rp, i);
  69.   RectFill (rp, 40+i*5, 0, 45+i*5, 10);
  70.  END
  71. END FarbTest;
  72.  
  73. PROCEDURE Zeichne;
  74. VAR x, y, col : INTEGER;
  75. BEGIN
  76.  FOR x:=0 TO MaxFeld DO
  77.   FOR y:=0 TO MaxFeld DO
  78.     IF (Z[x][y].zus=ges) THEN
  79.         col:=0
  80.     ELSIF (Z[x][y].zus=krnk) THEN
  81.         col:=MaxCol-2
  82.     ELSIF (Z[x][y].zus=inf)  THEN
  83.      col := INTEGER (FFP(Z[x][y].infi) / FarbFak);
  84.      IF (col<1) THEN  col:=1  ELSIF  (col>MaxCol-3) THEN  col:=MaxCol-3  END
  85.     END;
  86.     SetAPen (rp, col);
  87.     RectFill (rp, Z[x][y].x, Z[x][y].y, Z[x][y].dx, Z[x][y].dy);
  88.  END END
  89. END Zeichne;
  90.  
  91. PROCEDURE Kopi;
  92. VAR x, y : INTEGER;
  93. BEGIN
  94.  FOR x:=0 TO MaxFeld DO
  95.   FOR y:=0 TO MaxFeld DO
  96.    Z[x][y].infi := Zt[x][y].infi;
  97.    Z[x][y].zus := Zt[x][y].zus
  98.  END END
  99. END Kopi;
  100.  
  101. PROCEDURE Colors1;    (* $E- *)
  102. BEGIN
  103.  INLINE (0FFFH, 000FH, 005FH, 00BFH, 00FFH, 00FBH, 00F5H, 00F0H,
  104.       04F0H, 09F0H, 0DF0H, 0FD0H, 0F80H, 0F40H, 0F00H, 0000H)
  105. END Colors1;
  106.  
  107. PROCEDURE Colors2;     (* $E- *)
  108. BEGIN
  109.  INLINE (00B0H, 010EH, 020DH, 030CH, 040BH, 050AH, 0609H,
  110.       0708H, 0807H, 0906H, 0A05H, 0B04H, 0C03H, 0D02H, 0E01H,
  111.       0F00H, 0F10H, 0F20H, 0F30H, 0F40H, 0F50H, 0F60H, 0F70H,
  112.       0F80H, 0F90H, 0FA0H, 0FB0H, 0FC0H, 0FD0H, 0FE0H, 0FFFH, 0000H)
  113. END Colors2;
  114.  
  115. PROCEDURE ToggleCol;
  116. BEGIN
  117.  IF win#NIL THEN CloseWindow (win); win:=NIL; rp:=NIL END;
  118.  IF scr#NIL THEN CloseScreen (scr); scr:=NIL; vp:=NIL END;
  119.  IF NOT toggle THEN
  120.   DEPTH:=4;
  121.   scr := CreateScreen (WIDTH, HEIGHT, DEPTH, 0,1, ViewModeSet{}, NIL, NIL, NIL);
  122.   win := CreateWindow (0,0, WIDTH, HEIGHT,0,1,IDCMPFlagSet{rawKey,mouseButtons},
  123.          WindowFlagSet{borderless, activate, rmbTrap, noCareRefresh},
  124.          NIL, scr, NIL, NIL, customScreen);
  125.   MaxCol := 16;
  126.   FarbFak := FFP(MaxInf) / FFP(MaxCol-3);
  127.   vp := ADR (scr^.viewPort);
  128.   LoadRGB4 (vp, ADR(Colors1), MaxCol);
  129.   toggle:=TRUE;
  130.  ELSE
  131.   DEPTH:=5;
  132.   scr := CreateScreen (WIDTH, HEIGHT, DEPTH, 0,1,ViewModeSet{}, NIL, NIL, NIL);
  133.   win := CreateWindow (0,0, WIDTH, HEIGHT,0,1,IDCMPFlagSet{rawKey,mouseButtons},
  134.          WindowFlagSet{borderless, activate, rmbTrap, noCareRefresh},
  135.          NIL, scr, NIL, NIL, customScreen);
  136.   MaxCol := 32;
  137.   FarbFak := FFP(MaxInf) / FFP(MaxCol-3);
  138.   vp := ADR (scr^.viewPort);
  139.   LoadRGB4 (vp, ADR(Colors2), MaxCol);
  140.   toggle:=FALSE
  141.  END;
  142.  rp := win^.rPort;
  143.  SetRast (rp, MaxCol-1);
  144.  SetBPen (rp, MaxCol-1);
  145.  FarbTest;
  146.  Zeichne;
  147. END ToggleCol;
  148.  
  149. PROCEDURE Process;
  150. VAR xx, yy, AnzInf, AnzKrk, InfiSum    : INTEGER;
  151.     Durch                : LONGINT;
  152.     DuStr                : ARRAY [0..5] OF CHAR;
  153.     err, quit                : BOOLEAN;
  154. BEGIN
  155.  Durch := 0;    quit := FALSE; toggle:=FALSE;
  156.  REPEAT
  157.   INC (Durch);
  158.   ValToStr (Durch, FALSE, DuStr, 10, 6, " ", err);
  159.   SetAPen (rp, 30);
  160.   Move (rp, 5,275);
  161.   Text (rp, ADR(DuStr), 6);
  162.  
  163.   FOR yy:=0 TO MaxFeld DO
  164.    FOR xx:=0 TO MaxFeld DO
  165.  
  166.      IF ((xx>0) AND (yy>0) AND (xx<MaxFeld) AND (yy<MaxFeld)) THEN
  167.           IF (Z[xx][yy].zus = krnk) THEN        (* krank *)
  168.               Zt[xx][yy].zus := ges;
  169.               Zt[xx][yy].infi := ges
  170.           ELSIF (Z[xx][yy].zus = ges) THEN        (* gesund *)
  171.        AnzInf := 0; AnzKrk := 0;
  172.       IF (Z[xx-1][yy].zus = krnk) THEN INC (AnzKrk) END;
  173.       IF (Z[xx-1][yy].zus = inf)  THEN INC (AnzInf) END;
  174.       IF (Z[xx+1][yy].zus = krnk) THEN INC (AnzKrk) END;
  175.       IF (Z[xx+1][yy].zus = inf)  THEN INC (AnzInf) END;
  176.       IF (Z[xx][yy-1].zus = krnk) THEN INC (AnzKrk) END;
  177.       IF (Z[xx][yy-1].zus = inf)  THEN INC (AnzInf) END;
  178.       IF (Z[xx][yy+1].zus = krnk) THEN INC (AnzKrk) END;
  179.       IF (Z[xx][yy+1].zus = inf)  THEN INC (AnzInf) END;
  180.       Zt[xx][yy].infi := (AnzInf DIV k1) + (AnzKrk DIV k2)
  181.     ELSIF (Z[xx][yy].zus = inf) THEN        (* infiziert *)
  182.            InfiSum := 0; AnzInf := 0;
  183.       IF (Z[xx-1][yy].zus=ges) THEN INC(InfiSum, Z[xx-1][yy].infi) ELSE
  184.           INC (AnzInf); INC(InfiSum, Z[xx-1][yy].infi)
  185.       END;
  186.       IF (Z[xx+1][yy].zus=ges) THEN INC(InfiSum, Z[xx+1][yy].infi) ELSE
  187.           INC (AnzInf); INC(InfiSum, Z[xx+1][yy].infi)
  188.       END;
  189.       IF (Z[xx][yy-1].zus=ges) THEN INC(InfiSum, Z[xx][yy-1].infi) ELSE
  190.           INC (AnzInf); INC(InfiSum, Z[xx][yy-1].infi)
  191.       END;
  192.       IF (Z[xx][yy+1].zus=ges) THEN INC(InfiSum, Z[xx][yy+1].infi) ELSE
  193.           INC (AnzInf); INC(InfiSum, Z[xx][yy+1].infi)
  194.       END;
  195.       INC (InfiSum, Z[xx][yy].infi); INC (AnzInf);
  196.       Zt[xx][yy].infi := (InfiSum DIV AnzInf) + g
  197.     END;
  198.      ELSIF ((xx=0) AND (yy>0) AND (yy<MaxFeld)) THEN
  199.         IF (Z[xx][yy].zus = krnk) THEN        (* krank *)
  200.               Zt[xx][yy].zus := ges;
  201.               Zt[xx][yy].infi := ges
  202.           ELSIF (Z[xx][yy].zus = ges) THEN        (* gesund *)
  203.        AnzInf := 0; AnzKrk := 0;
  204.        IF (Z[xx+1][yy].zus = krnk) THEN INC (AnzKrk) END;
  205.        IF (Z[xx+1][yy].zus = inf)  THEN INC (AnzInf) END;
  206.        IF (Z[xx][yy-1].zus = krnk) THEN INC (AnzKrk) END;
  207.        IF (Z[xx][yy-1].zus = inf)  THEN INC (AnzInf) END;
  208.       IF (Z[xx][yy+1].zus = krnk) THEN INC (AnzKrk) END;
  209.       IF (Z[xx][yy+1].zus = inf) THEN INC (AnzInf) END;
  210.       Zt[xx][yy].infi := (AnzInf DIV k1) + (AnzKrk DIV k2);
  211.     ELSIF (Z[xx][yy].zus = inf) THEN        (* infiziert *)
  212.            InfiSum := 0; AnzInf := 0;
  213.       IF (Z[xx+1][yy].zus=ges) THEN INC(InfiSum, Z[xx+1][yy].infi) ELSE
  214.           INC (AnzInf); INC(InfiSum, Z[xx+1][yy].infi)
  215.       END;
  216.       IF (Z[xx][yy-1].zus=ges) THEN INC(InfiSum, Z[xx][yy-1].infi) ELSE
  217.           INC (AnzInf); INC(InfiSum, Z[xx][yy-1].infi)
  218.       END;
  219.       IF (Z[xx][yy+1].zus=ges) THEN INC(InfiSum, Z[xx][yy+1].infi) ELSE
  220.           INC (AnzInf); INC(InfiSum, Z[xx][yy+1].infi)
  221.       END;
  222.       INC (InfiSum, Z[xx][yy].infi); INC (AnzInf);
  223.       Zt[xx][yy].infi := (InfiSum DIV AnzInf) + g
  224.     END;
  225.      ELSIF ((xx>0) AND (xx<MaxFeld) AND (yy=0)) THEN
  226.          IF (Z[xx][yy].zus = krnk) THEN        (* krank *)
  227.               Zt[xx][yy].zus := ges;
  228.               Zt[xx][yy].infi := ges
  229.           ELSIF (Z[xx][yy].zus = ges) THEN        (* gesund *)
  230.        AnzInf := 0; AnzKrk := 0;
  231.       IF (Z[xx-1][yy].zus = krnk) THEN INC (AnzKrk) END;
  232.       IF (Z[xx-1][yy].zus = inf)  THEN  INC (AnzInf) END;
  233.       IF (Z[xx+1][yy].zus = krnk) THEN INC (AnzKrk) END;
  234.       IF (Z[xx+1][yy].zus = inf)  THEN INC (AnzInf) END;
  235.       IF (Z[xx][yy+1].zus = krnk) THEN INC (AnzKrk) END;
  236.       IF (Z[xx][yy+1].zus = inf) THEN INC (AnzInf) END;
  237.       Zt[xx][yy].infi := (AnzInf DIV k1) + (AnzKrk DIV k2);
  238.     ELSIF (Z[xx][yy].zus = inf) THEN        (* infiziert *)
  239.            InfiSum := 0; AnzInf := 0;
  240.       IF (Z[xx-1][yy].zus=ges) THEN INC(InfiSum, Z[xx-1][yy].infi) ELSE
  241.            INC (AnzInf); INC(InfiSum, Z[xx-1][yy].infi)
  242.       END;
  243.       IF (Z[xx+1][yy].zus=ges) THEN INC(InfiSum, Z[xx+1][yy].infi) ELSE
  244.           INC (AnzInf); INC(InfiSum, Z[xx+1][yy].infi)
  245.       END;
  246.       IF (Z[xx][yy+1].zus=ges) THEN INC(InfiSum, Z[xx][yy+1].infi) ELSE
  247.           INC (AnzInf); INC(InfiSum, Z[xx][yy+1].infi)
  248.       END;
  249.       INC (InfiSum, Z[xx][yy].infi); INC (AnzInf);
  250.       Zt[xx][yy].infi := (InfiSum DIV AnzInf) + g
  251.     END;
  252.      ELSIF ((xx>0) AND (xx<MaxFeld) AND (yy=MaxFeld)) THEN
  253.     IF (Z[xx][yy].zus = krnk) THEN        (* krank *)
  254.               Zt[xx][yy].zus := ges;
  255.               Zt[xx][yy].infi := ges
  256.           ELSIF (Z[xx][yy].zus = ges) THEN        (* gesund *)
  257.        AnzInf := 0; AnzKrk := 0;
  258.       IF (Z[xx-1][yy].zus = krnk) THEN INC (AnzKrk) END;
  259.       IF (Z[xx-1][yy].zus = inf)  THEN INC (AnzInf) END;
  260.       IF (Z[xx+1][yy].zus = krnk) THEN INC (AnzKrk) END;
  261.       IF (Z[xx+1][yy].zus = inf)  THEN INC (AnzInf) END;
  262.       IF (Z[xx][yy-1].zus = krnk) THEN INC (AnzKrk) END;
  263.       IF (Z[xx][yy-1].zus = inf) THEN INC (AnzInf) END;
  264.       Zt[xx][yy].infi := (AnzInf DIV k1) + (AnzKrk DIV k2);
  265.     ELSIF (Z[xx][yy].zus = inf) THEN        (* infiziert *)
  266.            InfiSum := 0; AnzInf := 0;
  267.       IF (Z[xx-1][yy].zus=ges) THEN INC(InfiSum, Z[xx-1][yy].infi) ELSE
  268.           INC (AnzInf); INC(InfiSum, Z[xx-1][yy].infi)
  269.       END;
  270.       IF (Z[xx+1][yy].zus=ges) THEN INC(InfiSum, Z[xx+1][yy].infi) ELSE
  271.           INC (AnzInf); INC(InfiSum, Z[xx+1][yy].infi)
  272.       END;
  273.       IF (Z[xx][yy-1].zus=ges) THEN INC(InfiSum, Z[xx][yy-1].infi) ELSE
  274.           INC (AnzInf); INC(InfiSum, Z[xx][yy-1].infi)
  275.       END;
  276.       INC (InfiSum, Z[xx][yy].infi); INC (AnzInf);
  277.       Zt[xx][yy].infi := (InfiSum DIV AnzInf) + g
  278.     END;
  279.  
  280.      ELSIF ((xx=MaxFeld) AND (yy>0) AND (yy<MaxFeld)) THEN
  281.     IF (Z[xx][yy].zus = krnk) THEN        (* krank *)
  282.               Zt[xx][yy].zus := ges;
  283.               Zt[xx][yy].infi := ges
  284.           ELSIF (Z[xx][yy].zus = ges) THEN        (* gesund *)
  285.        AnzInf := 0; AnzKrk := 0;
  286.       IF (Z[xx-1][yy].zus = krnk) THEN INC (AnzKrk) END;
  287.       IF (Z[xx-1][yy].zus = inf)  THEN INC (AnzInf) END;
  288.       IF (Z[xx][yy-1].zus = krnk) THEN INC (AnzKrk) END;
  289.       IF (Z[xx][yy-1].zus = inf)  THEN INC (AnzInf) END;
  290.       IF (Z[xx][yy+1].zus = krnk) THEN INC (AnzKrk) END;
  291.       IF (Z[xx][yy+1].zus = inf)  THEN INC (AnzInf) END;
  292.       Zt[xx][yy].infi := (AnzInf DIV k1) + (AnzKrk DIV k2);
  293.     ELSIF (Z[xx][yy].zus = inf) THEN        (* infiziert *)
  294.            InfiSum := 0; AnzInf := 0;
  295.       IF (Z[xx-1][yy].zus=ges) THEN INC(InfiSum, Z[xx-1][yy].infi) ELSE
  296.           INC (AnzInf); INC(InfiSum, Z[xx-1][yy].infi)
  297.       END;
  298.       IF (Z[xx][yy-1].zus=ges) THEN INC(InfiSum, Z[xx][yy-1].infi) ELSE
  299.           INC (AnzInf); INC(InfiSum, Z[xx][yy-1].infi)
  300.       END;
  301.       IF (Z[xx][yy+1].zus=ges) THEN INC(InfiSum, Z[xx][yy+1].infi) ELSE
  302.           INC (AnzInf); INC(InfiSum, Z[xx][yy+1].infi)
  303.       END;
  304.       INC (InfiSum, Z[xx][yy].infi); INC (AnzInf);
  305.       Zt[xx][yy].infi := (InfiSum DIV AnzInf) + g
  306.     END;
  307.      ELSIF ((xx=MaxFeld) AND (yy=0)) THEN
  308.     IF (Z[xx][yy].zus = krnk) THEN        (* krank *)
  309.               Zt[xx][yy].zus := ges;
  310.               Zt[xx][yy].infi := ges
  311.           ELSIF (Z[xx][yy].zus = ges) THEN        (* gesund *)
  312.        AnzInf := 0; AnzKrk := 0;
  313.       IF (Z[xx-1][yy].zus = krnk) THEN INC (AnzKrk) END;
  314.       IF (Z[xx-1][yy].zus = inf)  THEN INC (AnzInf) END;
  315.       IF (Z[xx][yy+1].zus = krnk) THEN INC (AnzKrk) END;
  316.       IF (Z[xx][yy+1].zus = inf) THEN INC (AnzInf) END;
  317.       Zt[xx][yy].infi := (AnzInf DIV k1) + (AnzKrk DIV k2);
  318.     ELSIF (Z[xx][yy].zus = inf) THEN        (* infiziert *)
  319.            InfiSum := 0; AnzInf := 0;
  320.       IF (Z[xx-1][yy].zus=ges) THEN INC(InfiSum, Z[xx-1][yy].infi) ELSE
  321.           INC (AnzInf); INC(InfiSum, Z[xx-1][yy].infi)
  322.       END;
  323.       IF (Z[xx][yy+1].zus=ges) THEN INC(InfiSum, Z[xx][yy+1].infi) ELSE
  324.           INC (AnzInf); INC(InfiSum, Z[xx][yy+1].infi)
  325.       END;
  326.       INC (InfiSum, Z[xx][yy].infi); INC (AnzInf);
  327.       Zt[xx][yy].infi := (InfiSum DIV AnzInf) + g
  328.     END;
  329.  
  330.      ELSIF ((xx=MaxFeld) AND (yy=MaxFeld)) THEN
  331.     IF (Z[xx][yy].zus = krnk) THEN        (* krank *)
  332.               Zt[xx][yy].zus := ges;
  333.               Zt[xx][yy].infi := ges
  334.           ELSIF (Z[xx][yy].zus = ges) THEN        (* gesund *)
  335.        AnzInf := 0; AnzKrk := 0;
  336.       IF (Z[xx-1][yy].zus = krnk) THEN INC (AnzKrk) END;
  337.       IF (Z[xx-1][yy].zus = inf)  THEN INC (AnzInf) END;
  338.       IF (Z[xx][yy-1].zus = krnk) THEN INC (AnzKrk) END;
  339.       IF (Z[xx][yy-1].zus = inf)  THEN INC (AnzInf) END;
  340.       Zt[xx][yy].infi := (AnzInf DIV k1) + (AnzKrk DIV k2);
  341.     ELSIF (Z[xx][yy].zus = inf) THEN        (* infiziert *)
  342.            InfiSum := 0; AnzInf := 0;
  343.       IF (Z[xx-1][yy].zus=ges) THEN INC(InfiSum, Z[xx-1][yy].infi) ELSE
  344.           INC (AnzInf); INC(InfiSum, Z[xx-1][yy].infi)
  345.       END;
  346.       IF (Z[xx][yy-1].zus=ges) THEN INC(InfiSum, Z[xx][yy-1].infi) ELSE
  347.           INC (AnzInf); INC(InfiSum, Z[xx][yy-1].infi)
  348.       END;
  349.       INC (InfiSum, Z[xx][yy].infi); INC (AnzInf);
  350.       Zt[xx][yy].infi := (InfiSum DIV AnzInf) + g
  351.     END;
  352.  
  353.      ELSIF ((xx=0) AND (yy=MaxFeld)) THEN
  354.     IF (Z[xx][yy].zus = krnk) THEN        (* krank *)
  355.               Zt[xx][yy].zus := ges;
  356.               Zt[xx][yy].infi := ges
  357.           ELSIF (Z[xx][yy].zus = ges) THEN        (* gesund *)
  358.        AnzInf := 0; AnzKrk := 0;
  359.       IF (Z[xx+1][yy].zus = krnk) THEN INC (AnzKrk) END;
  360.       IF (Z[xx+1][yy].zus = inf)  THEN INC (AnzInf) END;
  361.       IF (Z[xx][yy-1].zus = krnk) THEN INC (AnzKrk) END;
  362.       IF (Z[xx][yy-1].zus = inf)  THEN INC (AnzInf) END;
  363.       Zt[xx][yy].infi := (AnzInf DIV k1) + (AnzKrk DIV k2);
  364.     ELSIF (Z[xx][yy].zus = inf) THEN        (* infiziert *)
  365.            InfiSum := 0; AnzInf := 0;
  366.       IF (Z[xx+1][yy].zus=ges) THEN INC(InfiSum, Z[xx+1][yy].infi) ELSE
  367.           INC (AnzInf); INC(InfiSum, Z[xx+1][yy].infi)
  368.       END;
  369.       IF (Z[xx][yy-1].zus=ges) THEN INC(InfiSum, Z[xx][yy-1].infi) ELSE
  370.           INC (AnzInf); INC(InfiSum, Z[xx][yy-1].infi)
  371.       END;
  372.       INC (InfiSum, Z[xx][yy].infi); INC (AnzInf);
  373.       Zt[xx][yy].infi := (InfiSum DIV AnzInf) + g
  374.     END;
  375.      ELSIF ((xx=0) AND (yy=0)) THEN
  376.          IF (Z[xx][yy].zus = krnk) THEN        (* krank *)
  377.               Zt[xx][yy].zus := ges;
  378.               Zt[xx][yy].infi := ges
  379.           ELSIF (Z[xx][yy].zus = ges) THEN        (* gesund *)
  380.        AnzInf := 0; AnzKrk := 0;
  381.       IF (Z[xx+1][yy].zus = krnk) THEN INC (AnzKrk) END;
  382.       IF (Z[xx+1][yy].zus = inf)  THEN INC (AnzInf) END;
  383.       IF (Z[xx][yy+1].zus = krnk) THEN INC (AnzKrk) END;
  384.       IF (Z[xx][yy+1].zus = inf)  THEN INC (AnzInf) END;
  385.       Zt[xx][yy].infi := (AnzInf DIV k1) + (AnzKrk DIV k2);
  386.     ELSIF (Z[xx][yy].zus = inf) THEN        (* infiziert *)
  387.            InfiSum := 0; AnzInf := 0;
  388.       IF (Z[xx+1][yy].zus=ges) THEN INC(InfiSum, Z[xx+1][yy].infi) ELSE
  389.           INC (AnzInf); INC(InfiSum, Z[xx+1][yy].infi)
  390.       END;
  391.       IF (Z[xx][yy+1].zus=ges) THEN INC(InfiSum, Z[xx][yy+1].infi) ELSE
  392.           INC (AnzInf); INC(InfiSum, Z[xx][yy+1].infi)
  393.       END;
  394.       INC (InfiSum, Z[xx][yy].infi); INC (AnzInf);
  395.       Zt[xx][yy].infi := (InfiSum DIV AnzInf) + g
  396.     END
  397.      END;
  398.      IF (Zt[xx][yy].infi <= ges) THEN
  399.          Zt[xx][yy].infi := ges;
  400.          Zt[xx][yy].zus := ges
  401.      ELSIF (Zt[xx][yy].infi >= MaxInf) THEN
  402.          Zt[xx][yy].infi:=MaxInf;
  403.          Zt[xx][yy].zus:=krnk
  404.      ELSE
  405.         Zt[xx][yy].zus := inf
  406.      END;
  407.    END (* xx *)
  408.   END; (* yy *)
  409.   Kopi;
  410.   Zeichne;
  411.   Msg := GetMsg (win^.userPort);
  412.   WHILE Msg#NIL DO
  413.    IF Msg#NIL THEN class:=Msg^.class; code:=Msg^.code; ReplyMsg (Msg);
  414.      IF (mouseButtons IN class) THEN END;
  415.      IF (rawKey IN class) THEN
  416.       CASE code OF
  417.        FTaste    : ToggleCol  |
  418.        ESC    : quit:=TRUE |
  419.       ELSE
  420.    END END END;
  421.    Msg:=GetMsg (win^.userPort)
  422.   END
  423.  UNTIL quit;
  424. END Process;
  425.  
  426. PROCEDURE RandomSet;
  427. VAR xr, yr, infR : INTEGER;
  428. BEGIN
  429.  FOR xr:=0 TO MaxFeld DO
  430.   FOR yr:=0 TO MaxFeld DO
  431.    infR := RND (MaxInf+1);
  432.    Z[xr][yr].infi := infR;
  433.    IF infR <= ges THEN
  434.        Z[xr][yr].infi := ges;
  435.       Z[xr][yr].zus := ges
  436.    END;
  437.    IF (infR > ges) AND (infR < MaxInf) THEN  Z[xr][yr].zus := inf  END;
  438.    IF infR >= MaxInf THEN
  439.       Z[xr][yr].infi := MaxInf;
  440.       Z[xr][yr].zus := krnk
  441.    END
  442.  END END
  443. END RandomSet;
  444.  
  445. PROCEDURE SegInit;
  446. VAR xx, yy : INTEGER;
  447. BEGIN
  448.  FOR yy:=0 TO MaxFeld DO
  449.   FOR xx:=0 TO MaxFeld DO
  450.    WITH Z[xx][yy] DO
  451.     infi := ges; zus := ges;
  452.     x := 10+xx*2;  dx := 11+xx*2; y := 20+yy*2;  dy := 21+yy*2
  453.  END  END END
  454. END SegInit;
  455.  
  456. PROCEDURE Cleanup;
  457. BEGIN
  458.  IF Level >= CurrentLevel() THEN
  459.   IF win#NIL THEN CloseWindow (win) END;
  460.   IF scr#NIL THEN CloseScreen (scr) END
  461.  END
  462. END Cleanup;
  463.  
  464. PROCEDURE InitSys;
  465. BEGIN
  466.  TermProcedure (Cleanup);  Level := CurrentLevel();
  467.  
  468.  DEPTH := 5;
  469.  scr := CreateScreen (WIDTH, HEIGHT, DEPTH, 0,1, ViewModeSet{}, NIL, NIL, NIL);
  470.  win := CreateWindow (0,0, WIDTH, HEIGHT,0,1,IDCMPFlagSet{rawKey,mouseButtons},
  471.          WindowFlagSet{borderless, activate, rmbTrap, noCareRefresh},
  472.          NIL, scr, NIL, NIL, customScreen);
  473.  vp := ADR (scr^.viewPort);
  474.  rp := win^.rPort;
  475.  MaxCol := 32;
  476.  FarbFak := FFP(MaxInf) / FFP(MaxCol-3);
  477.  LoadRGB4 (vp, ADR(Colors2), MaxCol);
  478.  SetRast (rp, MaxCol-1);
  479.  SetBPen (rp, MaxCol-1);
  480. END InitSys;
  481.  
  482. PROCEDURE GetParams;
  483. BEGIN
  484.  WriteString ("Max. Feldgröße                    : ");    ReadInt (MaxFeld);
  485.  WriteString ("Max. Infizierungskoeffizient      : ");    ReadInt (MaxInf);
  486.  WriteString ("Infizierungsgeschwindigkeit (g)   : ");    ReadInt (g);
  487.  WriteString ("Widerstandsfähigkeit > Infizierte : ");    ReadInt (k1);
  488.  WriteString ("WiderStandsfähigkeit > Kranke     : ");    ReadInt (k2);
  489.  IF MaxInf < MaxCol-2 THEN MaxInf:=MaxCol-1 END;
  490.  DEC (MaxInf);
  491.  IF k1<=0 THEN k1:=1 END;
  492.  IF k2<=0 THEN k2:=1 END;
  493.  DEC (MaxFeld);
  494. END GetParams;
  495.  
  496.  
  497. BEGIN         (* HauptProgramm *)
  498.  waitCloseGadget := FALSE;
  499.  
  500.  GetParams;
  501.  InitSys;
  502.  FarbTest;
  503.  
  504.  SegInit;
  505.  RandomSet;
  506.  Zeichne;
  507.  
  508.  Process;
  509.  
  510. END MischMasch.
  511.